home *** CD-ROM | disk | FTP | other *** search
/ The Atari Compendium / The Atari Compendium (Toad Computers) (1994).iso / files / umich / tex / td187src.lzh / MTMENUS.I < prev    next >
Text File  |  1991-06-08  |  15KB  |  496 lines
  1. (*#######################################################################
  2.                             M A G I C M E N U S
  3.   #######################################################################
  4.   V1.02         27.10.90  Peter Hellinger
  5.   V1.01         21.10.90  Peter Hellinger
  6.   V1.00         02.09.90  Peter Hellinger
  7.   #######################################################################*)
  8.  
  9. IMPLEMENTATION MODULE mtMenus;
  10.  
  11. (*------------------------------*)
  12. (*       COMPILERSWITCHES       *)
  13. (*------------------------------*)
  14. (*  TDI-Version:   DEAKTIVIERT  *)
  15. (*------------------------------*)
  16. (* V-  Overflow-Checks          *)
  17. (* R-  Range-Checks             *)
  18. (* S-  Stack-Check              *)
  19. (* N-  NIL-Checks               *)
  20. (* T-  TDI-Compiler vor 3.01    *)
  21. (* Q+  Branch statt Jumps       *)
  22. (*                              *)
  23. (*------------------------------*)
  24. (*  MM2-Version:     AKTIVIERT  *)
  25. (*------------------------------*)
  26. (*$R-   Range-Checks            *)
  27. (*$S-   Stack-Check             *)
  28. (*                              *)
  29. (*------------------------------*)
  30.  
  31.  
  32. FROM SYSTEM     IMPORT  ADDRESS, ADR;
  33. FROM Storage    IMPORT  ALLOCATE, DEALLOCATE;
  34. FROM MagicSys   IMPORT  Nil, Null, Bit0, Bit1, Bit2, Bit3, Bit4, Bit5, Bit6, Bit7,
  35.                         Bit8, Bit9, Bit10, Bit11, Bit12, Bit13, Bit14, Bit15,
  36.                         LOC, Byte, ByteSet, sWORD, sINTEGER, sCARDINAL, sBITSET,
  37.                         lWORD, lINTEGER, lCARDINAL, lBITSET,
  38.                         CastToChar, CastToByte, CastToByteset, CastToInt,
  39.                         CastToCard, CastToBitset, CastToWord, CastToLInt,
  40.                         CastToLCard, CastToLBitset, CastToLWord, CastToAddr;
  41. FROM MagicAES   IMPORT  GBOX, GTEXT, GBOXTEXT, GIBOX, GSTRING, GTITLE,
  42.                         Exit, DISABLED, OBJECT, ObjcDraw, ObjcFind,
  43.                         BEGMCTRL, ENDMCTRL, WindUpdate, WFFULLXYWH, WindGet,
  44.                         FormButton, GrafHandle, MUKEYBD, MUBUTTON, MUM1, 
  45.                         MUM2, MUMESAG, MUTIMER, EvntMulti, AESIntIn, AESIntOut,
  46.                         AESCall;
  47. FROM mtAppl     IMPORT  VDIHandle, MouseOn, MouseOff, MouseArrow;
  48. FROM mtArea     IMPORT  AREA, NewAREA, DisposeAREA, FreeArea, SaveArea,
  49.                         CopyArea, RestoreArea, MOVEUP, MOVEDOWN, MOVELEFT,
  50.                         MOVERIGHT, MoveArea;
  51. FROM MagicStrings  IMPORT  Assign, Append, Length;
  52.  
  53. IMPORT  MagicAES, MagicVDI;
  54.  
  55.  
  56.  
  57. CONST   MaxObjects =    51;
  58.         Links =         Bit0;
  59.         Rechts =        Bit1;
  60.  
  61.  
  62. CONST   Enter =         072H;
  63.         Return =        01CH;
  64.         CurUp =         048H;
  65.         CurDown =       050H;
  66.         CurLeft =       04BH;
  67.         CurRight =      04DH;
  68.         Undo =          061H;
  69.  
  70.  
  71. TYPE    tRect =         RECORD
  72.                          x, y, w, h: sINTEGER;
  73.                         END;
  74.  
  75. TYPE    obTree =        POINTER TO ARRAY [0..1000] OF MagicAES.OBJECT;
  76.         tString =       ARRAY [0..40] OF CHAR;
  77.  
  78.  
  79. TYPE    MENUBAR =       POINTER TO Menubar;
  80.         Menubar =       RECORD
  81.                          line:  ARRAY [0..255] OF CHAR;
  82.                          tree:  obTree;
  83.                          num:   sINTEGER;
  84.                          win:   sINTEGER;
  85.                          sub:   sINTEGER;
  86.                          start: sINTEGER;
  87.                          draw:  sINTEGER;
  88.                          spos:  sINTEGER;
  89.                          entry: ARRAY [0..MaxObjects] OF RECORD
  90.                                  text: ARRAY [0..40] OF CHAR;
  91.                                  width: sINTEGER;
  92.                                  pos:   sINTEGER;
  93.                                 END;
  94.                          react: RECORD
  95.                                  x: sINTEGER;
  96.                                  y: sINTEGER;
  97.                                  w: sINTEGER;
  98.                                  h: sINTEGER;
  99.                                 END;
  100.                         END;
  101.  
  102.  
  103. VAR     Dropdown:       ARRAY [0..MaxObjects] OF OBJECT;
  104.         menuArea:       AREA;
  105.         BAR:            MENUBAR;
  106.         b:              sBITSET;
  107.         bool, rekExit:  BOOLEAN;
  108.         screen:         tRect;
  109.         chW, chH:       sINTEGER;
  110.         bW, bH:         sINTEGER;
  111.         mWidth:         sINTEGER;
  112.         mHeight:        sINTEGER;
  113.         ScrollStr:      ARRAY [0..9] OF CHAR;
  114.  
  115.  
  116. PROCEDURE scanType (t: obTree; entry, flag: sINTEGER): sINTEGER;
  117. (* Scannt nach einem bestimmten Typflag *)
  118. VAR o, r: sINTEGER;
  119. BEGIN
  120.  o:= entry;
  121.  WHILE (o >= entry)  DO
  122.   WITH t^[o] DO
  123.    IF flag = obType THEN  rekExit:= TRUE;  RETURN o;  END;
  124.    IF (obHead > -1) THEN
  125.     r:= scanType (t, obHead, flag);
  126.     IF rekExit THEN RETURN r; END;
  127.    END;
  128.    o:= obNext;
  129.   END;
  130.  END;
  131.  RETURN 0;
  132. END scanType;
  133.  
  134.  
  135. PROCEDURE DoEvent (VAR x, y: sINTEGER;
  136.                    VAR button: sBITSET;
  137.                    VAR scan: sINTEGER): sBITSET;
  138. VAR event: sBITSET;
  139.     i:     sINTEGER;
  140.     split: RECORD
  141.             CASE: BOOLEAN OF
  142.              TRUE: wert: sINTEGER;|
  143.              FALSE: hi: CHAR;
  144.                     lo: CHAR;|
  145.             END;
  146.            END;
  147. BEGIN
  148.  (* Array's laden *)
  149.  event:= {MUKEYBD, MUTIMER, MUBUTTON};
  150.  AESIntIn[ 0]:= CastToInt (event);
  151.  AESIntIn[ 1]:= 257;
  152.  AESIntIn[ 2]:= 3;
  153.  AESIntIn[ 3]:= 0;
  154.  i:= AESCall(25, 16, 7, 1, 0);
  155.  event:= CastToBitset (i);
  156.  x:= AESIntOut[1];
  157.  y:= AESIntOut[2];
  158.  button:= CastToBitset (AESIntOut[3]);
  159.  (* kbshift:= CastToBitset (AESIntOut[4]); *)
  160.  split.wert:= AESIntOut[5];
  161.  scan:= ORD (split.hi);
  162.  (* ascii:= split.lo; *)
  163.  RETURN event;
  164. END DoEvent;
  165.  
  166.  
  167. PROCEDURE Entprelle;
  168. VAR x, y:   sINTEGER;
  169.     button: sBITSET;
  170. BEGIN
  171.  REPEAT
  172.   MagicAES.GrafMkstate (x, y, button, b);
  173.  UNTIL button = {};
  174. END Entprelle;
  175.  
  176.  
  177. PROCEDURE GetMenu (mx, my: sINTEGER): sINTEGER;
  178. VAR j: sINTEGER;
  179. BEGIN
  180.  WITH BAR^ DO
  181.   WITH react DO
  182.    IF (my > y) AND (my < (y + h)) THEN
  183.     IF (mx > x) AND (mx < (x + 3 * chW)) THEN  RETURN -2;  END;
  184.     IF (mx > (x + 3 * chW) - 1) AND (mx < (x + 6 * chW)) THEN  RETURN -3;  END;
  185.     FOR j:= start TO draw DO
  186.      IF (mx >= (x + entry[j].pos)) AND
  187.         (mx <= (x + entry[j].pos + entry[j].width)) THEN
  188.       RETURN j;
  189.      END;
  190.     END;
  191.    END;
  192.   END;
  193.  END;
  194.  RETURN -1; 
  195. END GetMenu;
  196.  
  197.  
  198. PROCEDURE DoMenu (t: obTree; drop: sINTEGER): sINTEGER;
  199. VAR mx, my, ox, oy, i, j, o: sINTEGER;
  200.     ob, oldob, taste, scan, clicks: sINTEGER;
  201.     button, kbshift, event: sBITSET;
  202.     ascii: CHAR;
  203.  
  204.  PROCEDURE DrawBar (o: sINTEGER);
  205.  VAR r: tRect;
  206.  BEGIN
  207.   IF o > 0 THEN
  208.    r.x:= t^[0].obX + t^[o].obX;
  209.    r.y:= t^[0].obY + t^[o].obY;
  210.    r.w:= r.x + t^[o].obWidth - 1;
  211.    r.h:= r.y + t^[o].obHeight - 1;
  212.    MagicVDI.Bar (VDIHandle, r);
  213.   END;
  214.  END DrawBar;
  215.  
  216. BEGIN
  217.  i:= MagicVDI.SetFillcolor (VDIHandle, 1); 
  218.  bool:= MagicVDI.SetFillperimeter (VDIHandle, FALSE);
  219.  oldob:= -1;  ob:= -1;  ox:= -1;  oy:= -1;
  220.  LOOP
  221.   event:= DoEvent (mx, my, button, scan);
  222.   (* Anderes Menü gewählt? *)
  223.   j:= GetMenu (mx, my); 
  224.   IF (j # -1) AND (j # drop) THEN  RETURN -1;  END;
  225.   (* Objekt finden *)
  226.   IF (mx # ox) OR (my # oy) THEN
  227.    ob:= MagicAES.ObjcFind (t, 0, MaxObjects, mx, my);  ox:= mx;  oy:= my;
  228.   END;
  229.   IF (MUKEYBD IN event) THEN
  230.    CASE scan OF
  231.     Return,
  232.     Enter:      MouseOff;  DrawBar (oldob);  MouseOn;  EXIT;
  233.                 |
  234.     CurUp:      o:= ob;
  235.                 IF o > 1 THEN
  236.                  DEC (o);
  237.                  IF (DISABLED IN t^[o].obState) THEN  DEC (o); END;
  238.                  IF o >= 1 THEN  ob:= o;  END;
  239.                 ELSE
  240.                  ob:= t^[0].obTail;
  241.                 END;
  242.                 |
  243.      CurDown:   o:= ob;
  244.                 IF (o < t^[0].obTail) AND (o > 0) THEN
  245.                 INC (o);
  246.                 IF (DISABLED IN t^[o].obState) THEN  INC (o); END;
  247.                 IF o <= t^[0].obTail THEN  ob:= o;  END;
  248.                 ELSE
  249.                 ob:= 1;
  250.                 END;
  251.                 |
  252.      Undo:      ob:= -1;  EXIT;
  253.                 |
  254.      ELSE ;
  255.    END;
  256.   END;
  257.   (* Rechte Maust